home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / zgebak.f < prev    next >
Text File  |  1996-07-19  |  5KB  |  191 lines
  1.       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
  2.      $                   INFO )
  3. *
  4. *  -- LAPACK routine (version 2.0) --
  5. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  6. *     Courant Institute, Argonne National Lab, and Rice University
  7. *     September 30, 1994
  8. *
  9. *     .. Scalar Arguments ..
  10.       CHARACTER          JOB, SIDE
  11.       INTEGER            IHI, ILO, INFO, LDV, M, N
  12. *     ..
  13. *     .. Array Arguments ..
  14.       DOUBLE PRECISION   SCALE( * )
  15.       COMPLEX*16         V( LDV, * )
  16. *     ..
  17. *
  18. *  Purpose
  19. *  =======
  20. *
  21. *  ZGEBAK forms the right or left eigenvectors of a complex general
  22. *  matrix by backward transformation on the computed eigenvectors of the
  23. *  balanced matrix output by ZGEBAL.
  24. *
  25. *  Arguments
  26. *  =========
  27. *
  28. *  JOB     (input) CHARACTER*1
  29. *          Specifies the type of backward transformation required:
  30. *          = 'N', do nothing, return immediately;
  31. *          = 'P', do backward transformation for permutation only;
  32. *          = 'S', do backward transformation for scaling only;
  33. *          = 'B', do backward transformations for both permutation and
  34. *                 scaling.
  35. *          JOB must be the same as the argument JOB supplied to ZGEBAL.
  36. *
  37. *  SIDE    (input) CHARACTER*1
  38. *          = 'R':  V contains right eigenvectors;
  39. *          = 'L':  V contains left eigenvectors.
  40. *
  41. *  N       (input) INTEGER
  42. *          The number of rows of the matrix V.  N >= 0.
  43. *
  44. *  ILO     (input) INTEGER
  45. *  IHI     (input) INTEGER
  46. *          The integers ILO and IHI determined by ZGEBAL.
  47. *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  48. *
  49. *  SCALE   (input) DOUBLE PRECISION array, dimension (N)
  50. *          Details of the permutation and scaling factors, as returned
  51. *          by ZGEBAL.
  52. *
  53. *  M       (input) INTEGER
  54. *          The number of columns of the matrix V.  M >= 0.
  55. *
  56. *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
  57. *          On entry, the matrix of right or left eigenvectors to be
  58. *          transformed, as returned by ZHSEIN or ZTREVC.
  59. *          On exit, V is overwritten by the transformed eigenvectors.
  60. *
  61. *  LDV     (input) INTEGER
  62. *          The leading dimension of the array V. LDV >= max(1,N).
  63. *
  64. *  INFO    (output) INTEGER
  65. *          = 0:  successful exit
  66. *          < 0:  if INFO = -i, the i-th argument had an illegal value.
  67. *
  68. *  =====================================================================
  69. *
  70. *     .. Parameters ..
  71.       DOUBLE PRECISION   ONE
  72.       PARAMETER          ( ONE = 1.0D+0 )
  73. *     ..
  74. *     .. Local Scalars ..
  75.       LOGICAL            LEFTV, RIGHTV
  76.       INTEGER            I, II, K
  77.       DOUBLE PRECISION   S
  78. *     ..
  79. *     .. External Functions ..
  80.       LOGICAL            LSAME
  81.       EXTERNAL           LSAME
  82. *     ..
  83. *     .. External Subroutines ..
  84.       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
  85. *     ..
  86. *     .. Intrinsic Functions ..
  87.       INTRINSIC          MAX, MIN
  88. *     ..
  89. *     .. Executable Statements ..
  90. *
  91. *     Decode and Test the input parameters
  92. *
  93.       RIGHTV = LSAME( SIDE, 'R' )
  94.       LEFTV = LSAME( SIDE, 'L' )
  95. *
  96.       INFO = 0
  97.       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  98.      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
  99.          INFO = -1
  100.       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
  101.          INFO = -2
  102.       ELSE IF( N.LT.0 ) THEN
  103.          INFO = -3
  104.       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  105.          INFO = -4
  106.       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  107.          INFO = -5
  108.       ELSE IF( M.LT.0 ) THEN
  109.          INFO = -7
  110.       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
  111.          INFO = -9
  112.       END IF
  113.       IF( INFO.NE.0 ) THEN
  114.          CALL XERBLA( 'ZGEBAK', -INFO )
  115.          RETURN
  116.       END IF
  117. *
  118. *     Quick return if possible
  119. *
  120.       IF( N.EQ.0 )
  121.      $   RETURN
  122.       IF( M.EQ.0 )
  123.      $   RETURN
  124.       IF( LSAME( JOB, 'N' ) )
  125.      $   RETURN
  126. *
  127.       IF( ILO.EQ.IHI )
  128.      $   GO TO 30
  129. *
  130. *     Backward balance
  131. *
  132.       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
  133. *
  134.          IF( RIGHTV ) THEN
  135.             DO 10 I = ILO, IHI
  136.                S = SCALE( I )
  137.                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  138.    10       CONTINUE
  139.          END IF
  140. *
  141.          IF( LEFTV ) THEN
  142.             DO 20 I = ILO, IHI
  143.                S = ONE / SCALE( I )
  144.                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
  145.    20       CONTINUE
  146.          END IF
  147. *
  148.       END IF
  149. *
  150. *     Backward permutation
  151. *
  152. *     For  I = ILO-1 step -1 until 1,
  153. *              IHI+1 step 1 until N do --
  154. *
  155.    30 CONTINUE
  156.       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
  157.          IF( RIGHTV ) THEN
  158.             DO 40 II = 1, N
  159.                I = II
  160.                IF( I.GE.ILO .AND. I.LE.IHI )
  161.      $            GO TO 40
  162.                IF( I.LT.ILO )
  163.      $            I = ILO - II
  164.                K = SCALE( I )
  165.                IF( K.EQ.I )
  166.      $            GO TO 40
  167.                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  168.    40       CONTINUE
  169.          END IF
  170. *
  171.          IF( LEFTV ) THEN
  172.             DO 50 II = 1, N
  173.                I = II
  174.                IF( I.GE.ILO .AND. I.LE.IHI )
  175.      $            GO TO 50
  176.                IF( I.LT.ILO )
  177.      $            I = ILO - II
  178.                K = SCALE( I )
  179.                IF( K.EQ.I )
  180.      $            GO TO 50
  181.                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
  182.    50       CONTINUE
  183.          END IF
  184.       END IF
  185. *
  186.       RETURN
  187. *
  188. *     End of ZGEBAK
  189. *
  190.       END
  191.